home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / dialogs.tcl < prev    next >
Encoding:
Text File  |  1998-12-15  |  61.5 KB  |  2,091 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "dialogs.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 15/12/1998 {9:31:42 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Much copyright (c) 1997-1998  Vince Darley, all rights reserved, 
  15.  # rest Pete Keleher, Johan Linde.
  16.  # 
  17.  # Reorganisation carried out by Vince Darley with much help from Tom 
  18.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  19.  # Alpha is shareware; please register with the author using the register 
  20.  # button in the about box.
  21.  #  
  22.  #  Description: 
  23.  # 
  24.  # Much more flexible dialogs for querying the user about flags and
  25.  # vars.  These may be global, mode-dependent, or package-dependent.
  26.  # 
  27.  # Things you may wish to do:
  28.  # 
  29.  #  dialog::pkg_options Pkg
  30.  #  
  31.  # creates a dialog for all array entries 'PkgmodeVars'.  These
  32.  # must have been previously declared using 'newPref'.  These
  33.  # variables are _not_ copied into the global scope; only
  34.  # existing as array entries.
  35.  # 
  36.  # Note that rather than setting up traces on variables, you are
  37.  # often better off using the optional proc argument to newPref;
  38.  # the name of a procedure to call if that element is changed by
  39.  # the user.
  40.  # 
  41.  # The old procedure 'newModeVar' is obsolete.  Use the
  42.  # new procedure 'newPref'.  Why?  It has optional arguments
  43.  # which allow you to declare:
  44.  # 
  45.  #  lists
  46.  #  indexed lists
  47.  #  folders
  48.  #  files
  49.  #  bindings
  50.  #  menu-bindings
  51.  #  applications
  52.  #  variable-list elements
  53.  #  array elements
  54.  #  
  55.  # all of which can be set using the same central mode/global
  56.  # dialogs.
  57.  #  
  58.  # It also lets you add an optional procedure to call when an
  59.  # item changes...  Also if Alpha upgrades to Tcl 8 and namespaces, 
  60.  # it is easy to modify that central procedure to fit everything 
  61.  # with the new scheme.
  62.  # 
  63.  # Most modes will just want to declare their vars using newPref.  
  64.  # There is usually no need to do _anything_ else.
  65.  # 
  66.  # ---
  67.  # 
  68.  # The prefs dialog procs below were based upon Pete Keleher's 
  69.  # originals.
  70.  # ###################################################################
  71.  ##
  72.  
  73. namespace eval dialog {}
  74. namespace eval global {}
  75. namespace eval flag {}
  76.  
  77.  
  78.     
  79. # ◊◊◊◊ Toplevel dialog procedures ◊◊◊◊ #
  80.  
  81. ## 
  82.  # -------------------------------------------------------------------------
  83.  # 
  84.  # "dialog::pkg_options" --
  85.  # 
  86.  #  Make a dialog for the given package, with 'title' for the dialog box.
  87.  #  'not_global' indicates the variables are never copied into the global
  88.  #  scope, remaining in their array ${pkg}modeVars (or '$var' if it is given)
  89.  # 
  90.  # Results:
  91.  #  Nothing
  92.  # 
  93.  # Side effects:
  94.  #  May modify any of the given package's variables.
  95.  # 
  96.  # --Version--Author------------------Changes-------------------------------
  97.  #    1.0     <darley@fas.harvard.edu> original
  98.  # -------------------------------------------------------------------------
  99.  ##
  100. proc dialog::pkg_options {pkg {title ""} {not_global 1} {var ""}} {
  101.     if {!$not_global} {
  102.     # make sure the package variables are global
  103.     global ${pkg}modeVars
  104.     if {[info exists ${pkg}modeVars]} {
  105.         foreach v [array names ${pkg}modeVars] {
  106.         global $v
  107.         set $v [set ${pkg}modeVars($v)]
  108.         }
  109.     }
  110.     }
  111.     if {$title == ""} { 
  112.     set title "Preferences for the '[quote::Prettify $pkg]' package" 
  113.     }
  114.     if {$not_global} {
  115.     global dialog::_not_global_flag
  116.     if {$var == ""} {
  117.         set dialog::_not_global_flag ${pkg}modeVars
  118.     } else {
  119.         set dialog::_not_global_flag $var
  120.     }
  121.     }
  122.     set err [catch {dialog::modifyModeFlags $title $not_global $pkg} result]
  123.     if {$not_global} {
  124.     global dialog::_not_global_flag
  125.     set dialog::_not_global_flag ""
  126.     }
  127.     if {$err} {
  128.     error $result
  129.     }
  130. }
  131. proc dialog::edit_array {var {title ""}} {
  132.     if {$title == ""} {set title "Contents of '$var' array"}
  133.     dialog::pkg_options "" $title 1 $var
  134. }
  135. ## 
  136.  # -------------------------------------------------------------------------
  137.  # 
  138.  # "dialog::variable" --
  139.  # 
  140.  #  Ask for a value, with default given by the given variable, and using
  141.  #  that variable's type (list, file, ...) as a constraint.
  142.  #  
  143.  #  Currently assumes the variable is a list var, but this will change.
  144.  # -------------------------------------------------------------------------
  145.  ##
  146. proc dialog::variable {var {title ""}} {
  147.     if {$title == ""} { set title [quote::Prettify $var] }
  148.     return [dialog::optionMenu $title [flag::options $var] \
  149.       [uplevel [list set $var]]]
  150. }
  151.  
  152.  
  153. ## 
  154.  # -------------------------------------------------------------------------
  155.  # 
  156.  # "dialog::paged" --
  157.  # 
  158.  #  Under development.  Not yet usable!
  159.  # -------------------------------------------------------------------------
  160.  ##
  161. proc dialog::paged {args} {
  162.     getOpts {-pageproc}
  163.     set pages [lindex $args 0]
  164.     lappend dialog -m [concat [lindex $pages 0] $pages] 100 10 200 40
  165.     set xmax -1
  166.     set ymax -1
  167.     set i 1
  168.     foreach page $pages {
  169.     lappend dialog -n $page
  170.     set contents [$opts(-pageproc) $page 20 50]
  171.     set x [lindex $contents 0]
  172.     set y [lindex $contents 1]
  173.     set contents [lindex $contents 2]
  174.     if {$x > $xmax} { set xmax $x }
  175.     if {$y > $ymax} { set ymax $x }
  176.     incr i
  177.     }
  178.     incr ymax 15
  179.     incr xmax 20
  180.     eval dialog -w $xmax -h [expr {$ymax+40}] [dialog::okcancel 10 ymax] $dialog
  181. }
  182.  
  183. proc helperApps {} {
  184.     set sigs [info globals *Sig]
  185.     regsub -all {Sig} $sigs {} sigs
  186.     set sig [listpick -p "Change/inspect which helper?" [lsort $sigs]]
  187.     set sig ${sig}Sig
  188.     global $sig
  189.     if {![info exists $sig]} { set $sig "" }
  190.     set nsig [dialog::askFindApp $sig [set $sig]]
  191.     if {$nsig != "" && [set $sig] != $nsig} {
  192.     set $sig $nsig
  193.     global modifiedVars
  194.     lappend modifiedVars $sig
  195.     }
  196. }
  197.  
  198. proc suffixMappings {} {
  199.     global filepats
  200.     
  201.     set l1 5
  202.     set w1 38
  203.     set l2 [expr {$l1 + $w1 + 5}]
  204.     set w2 200
  205.     set h 18
  206.     set top 5
  207.     set mar 5
  208.     
  209.     set modes [lsort -ignore [array names filepats]]
  210.     set len [expr {[llength $modes] + 1}]
  211.     set modes1 [lrange $modes 0 [expr {$len/2 - 1}]]
  212.     set modes2 [lrange $modes [expr {$len/2}] end]
  213.     
  214.     foreach m $modes1 {
  215.     lappend items -t $m $l1 $top [expr {$l1 + $w1}] [expr {$top + $h}]
  216.     lappend items -e $filepats($m) $l2 $top [expr {$l2 + $w2}] \
  217.       [expr {$top + $h - 2}]
  218.     incr top [expr {$h + $mar}]
  219.     }
  220.     
  221.     set top2 5
  222.     set l1 [expr {$l2 + $w2 + 20}]
  223.     set l2 [expr {$l1 + $w1 + 5}]
  224.     foreach m $modes2 {
  225.     lappend items -t $m $l1 $top2 [expr {$l1 + $w1}] [expr {$top2 + $h}]
  226.     lappend items -e $filepats($m) $l2 $top2 [expr {$l2 + $w2}] \
  227.       [expr {$top2 + $h - 2}]
  228.     incr top2 [expr {$h + $mar}]
  229.     }
  230.     
  231.     if {$top2 > $top} {
  232.     set top $top2
  233.     }
  234.     incr top $mar
  235.     
  236.     set l1 5
  237.     lappend buts -b OK $l1 $top [expr {$l1 + 60}] [expr {$top + 20}]
  238.     lappend buts -b Cancel [expr {$l1 + 100}] $top [expr {$l1 + 160}] \
  239.       [expr {$top + 20}]
  240.     
  241.     set res [eval "dialog -w [expr {$l2 + $w2 + 10}] -h [expr {$top + 27}]" \
  242.       $buts $items]
  243.     
  244.     if {[lindex $res 0]} {
  245.     set res [lrange $res 2 end]
  246.     
  247.     foreach m [lsort -ignore [array names filepats]] {
  248.         if {$filepats($m) != [lindex $res 0]} {
  249.         lappend changed [list $m [lindex $res 0]]
  250.         }
  251.         set res [lrange $res 1 end]
  252.     }
  253.     
  254.     foreach pair $changed {
  255.         eval addArrDef filepats [lrange $pair 0 1]
  256.         set filepats([lindex $pair 0]) [lindex $pair 1]
  257.     }
  258.     }
  259.     mode::updateSuffixes
  260. }
  261. proc dialog::mode {flags vars {title ""}} {
  262.     set lim [expr {10 - [llength $flags]/4}]
  263.     if {[llength $vars] > $lim } {
  264.     set args {}
  265.     set nvars [llength $vars]
  266.     set j 0
  267.     for {set i 0} {$i < $nvars} {incr i $lim ; set lim 10} {
  268.         lappend args [list "Page [incr j] of ${title}" $flags \
  269.           [lrange $vars $i [expr {$i+$lim -1}]]]
  270.         set flags ""
  271.     }
  272.     dialog::multipage $args
  273.     } else {
  274.     dialog::onepage $flags $vars $title
  275.     }
  276. }
  277. ## 
  278.  # -------------------------------------------------------------------------
  279.  # 
  280.  # "dialog::modifyModeFlags" --
  281.  # 
  282.  #  Currently 'not_global == 0' implies this is a mode, or at least that
  283.  #  the variables are stored in ${mm}modeVars(...)
  284.  #  
  285.  #  'not_global == 1' implies that the variables are stored in the
  286.  #  array given by the value of the variable 'dialog::_not_global_flag'
  287.  #  
  288.  #  Recently removed a call to mode::updateSuffixes which is not necessary
  289.  # -------------------------------------------------------------------------
  290.  ##
  291. proc dialog::modifyModeFlags {{title ""} {not_global 0} {mm ""}} {
  292.     global mode invisibleModeVars modifiedArrayElements \
  293.       dialog::_not_global_flag allFlags flag::procs
  294.     # Check whether this is a mode or package, and where variable values
  295.     # are stored, and whether that's at the global level as well as in
  296.     # an array...
  297.     if {$not_global} {
  298.     set storage ${dialog::_not_global_flag}
  299.     if {$title == ""} {
  300.         set title "Preferences for '${mm}' package"
  301.     }
  302.     } else {
  303.     if {$mm == ""} { 
  304.         set mm $mode 
  305.         if {$mm == ""} {
  306.         alertnote "No mode set!"
  307.         return
  308.         }
  309.     }
  310.     set storage ${mm}modeVars
  311.     if {$title == ""} {
  312.         set title "Preferences for '${mm}' mode"
  313.     }
  314.     }
  315.     # check for mode specific proc
  316.     if {[info commands ${mm}modifyFlags] != ""} {${mm}modifyFlags; return}
  317.     if {[info tclversion] >= 8.0} { set storage ::$storage }
  318.     set flags {}
  319.     set vars {}
  320.     global $storage ${storage}Invisible
  321.     if {[info exists $storage]} {
  322.     set unsortedNames [array names $storage]
  323.     set colors {}
  324.     set rest {}
  325.     foreach i $unsortedNames {
  326.         if {[regexp {Colou?r$} $i]} {
  327.         lappend colors $i
  328.         } else {
  329.         lappend rest $i
  330.         }
  331.     }
  332.     
  333.     foreach v [concat [lsort $rest] [lsort $colors]] {
  334.         if {[info exists invisibleModeVars($v)] \
  335.           || [info exists ${storage}Invisible($v)]} continue
  336.         
  337.         if {[lsearch $allFlags $v] >= 0} {
  338.         lappend flags $v
  339.         } else {
  340.         lappend vars $v
  341.         }
  342.     }
  343.     
  344.     set values_items [dialog::mode $flags $vars $title]
  345.     set res [lindex $values_items 0]
  346.     set editItems [lindex $values_items 1]
  347.     unset values_items
  348.     
  349.     foreach fset $editItems {
  350.         if {[llength $fset] > 1} {
  351.         set fset [lrange $fset 1 end]
  352.         }
  353.         foreach flag $fset {
  354.         set val [lindex $res 0]
  355.         set res [lrange $res 1 end]
  356.         dialog::postManipulate
  357.         if {$not_global} {
  358.             # it's a package which keeps its vars in the array
  359.             if {[set ${storage}($flag)] != $val} {
  360.             set ${storage}($flag) $val
  361.             lappend modifiedArrayElements [list $flag $storage]
  362.             if {[info exists flag::procs($flag)]} {
  363.                 eval [set flag::procs($flag)] [list $flag]
  364.             }
  365.             }
  366.         } else {
  367.             # modes keep a copy of their vars at the global 
  368.             # level when active
  369.             global $flag
  370.             if {[set $flag] != $val} {
  371.             set $flag $val
  372.             set ${storage}($flag) $val
  373.             lappend modifiedArrayElements [list $flag $storage]
  374.             
  375.             if {[info exists flag::procs($flag)]} {
  376.                 eval [set flag::procs($flag)] [list $flag]
  377.             }
  378.             }
  379.         }
  380.         }
  381.     }
  382.     } else {
  383.     alertnote "The '$mm' mode/package has no preference settings."
  384.     }
  385.     
  386.     hook::callAll dialog::modifyModeFlags $mm $title
  387.     
  388. }
  389.  
  390. ## 
  391.  # -------------------------------------------------------------------------
  392.  # 
  393.  # "dialog::getAKey" --
  394.  # 
  395.  #  Returns a keystring to be used for binding a key in a menu, 
  396.  #  using a nice dialog box to ask the user.
  397.  # 
  398.  #  Possible improvements: we could replace the dialog
  399.  #  box with a status-line prompt (which would allow the use of
  400.  #  getModifiers to check what keys the user pressed).
  401.  #  
  402.  #  Now handles 'prefixChar' bindings for non-menu items.
  403.  #  i.e. you can use this dialog to bind something to 'ctrl-x ctrl-s',
  404.  #  for instance.
  405.  # 
  406.  #  If the name contains '/' it is considered to be two items,
  407.  #  separated by that '/', which are to take the same binding,
  408.  #  except that one of them will use the option key.
  409.  #  
  410.  #  Similarly '//' means use shift, '///' means shift-option,
  411.  #  For instance 'dialog::getAKey close/closeAll//closeFloat /W<O'
  412.  #  would give you the menu-item for 'close' in the file menu. 
  413.  #  except these last two aren't implemented yet ;-)
  414.  # --Version--Author------------------Changes-------------------------------
  415.  #    1.0     Johan Linde         original
  416.  #    1.1     <darley@fas.harvard.edu> can do non-menu bindings too
  417.  #    1.2     <darley@fas.harvard.edu> handles arrow keys
  418.  #    1.2.1   Johan Linde        handles key pad keys
  419.  # -------------------------------------------------------------------------
  420.  ##
  421. proc dialog::getAKey {{name {}} {keystr {}} {for_menu 1}} {
  422.     global keys::func
  423.     # two lists for any other keys which look better with a text description
  424.     set otherKeys {"<No binding>" "-" Space}
  425.     set otherKeyChars [list "" "" " "]
  426.     if {!$for_menu} {
  427.     lappend otherKeys Left Right Up Down "Key pad =" \
  428.       "Key pad /" "Key pad *" "Key pad -" "Key pad +" "Key pad ."
  429.     lappend otherKeyChars "" "" "\x10" "" Kpad= \
  430.       Kpad/ Kpad* Kpad- Kpad+ Kpad.
  431.     for {set i 0} {$i < 10} {incr i} {
  432.         lappend otherKeys "Key pad $i"
  433.         lappend otherKeyChars Kpad$i
  434.     }
  435.     }
  436.     set nname $name
  437.     set shift-opt [expr {![regsub {///} $nname { so-} $nname]}]
  438.     set shift  [expr {![regsub {//} $nname { s-} $nname]}]
  439.     set option [expr {![regsub {/} $nname { o-} $nname]}]
  440.     if {[string length $keystr]} {
  441.     set values "0 0"
  442.     set mkey [keys::verboseKey $keystr normal]
  443.     if {$normal} {
  444.         lappend values "Normal Key"
  445.     } else {
  446.         lappend values $mkey
  447.         set mkey {}
  448.     }
  449.     lappend values [regexp {<U} $keystr]
  450.     lappend values [regexp {<B} $keystr]
  451.     if {!$for_menu} {
  452.         if {[regexp "«(.*)»" $keystr "" i]} {
  453.         if {$i == "e"} {
  454.             lappend values "escape"
  455.         } else {
  456.             lappend values "ctrl-$i"
  457.         }
  458.         } else {
  459.         lappend values "<none>"
  460.         }
  461.     }
  462.     if {$option} {lappend values [regexp {<I} $keystr]}
  463.     lappend values [regexp {<O} $keystr]
  464.     lappend values $mkey
  465.     } else {
  466.     set values {0 0 "" 0 0}
  467.     if {!$for_menu} { lappend values <none> }
  468.     if {$option} {lappend values 0}
  469.     lappend values 0 ""
  470.     }
  471.     if {$for_menu} {
  472.     set title "Menu key binding"
  473.     } else {
  474.     set title "Key binding"
  475.     set prefixes [keys::findPrefixChars]
  476.     foreach i $prefixes {
  477.         lappend prefix "ctrl-$i"
  478.     }
  479.     lappend prefixes e
  480.     lappend prefix "escape"
  481.     }
  482.     if {$name != ""} { append title " for '$name'" }
  483.     set usep [info exists prefix]
  484.     while {1} {
  485.     # Build box
  486.     set box "-t [list $title] 10 10 315 25  -t Key 10 40 40 55  -m [list [concat [list [lindex $values 2]]  [list "Normal key"] $otherKeys ${keys::func}]] 80 40 180 55  -c Shift [list [lindex $values 3]] 10 70 60 85  -c Control [list [lindex $values 4]] 80 70 150 85"
  487.     if {$usep} {
  488.         lappend box -t Prefix 190 40 230 55  -m [concat [list [lindex $values 5]]  "<none>" "-" $prefix]  235 40 315 55
  489.     }
  490.     if {$option} {lappend box -c Option [lindex $values [expr {5 + $usep}]] 160 70 220 85}
  491.     lappend box -c Command [lindex $values [expr {5 + $option +$usep}]] 230 70 315 85
  492.     lappend box -n "Normal key" -e [lindex $values [expr {6 + $option +$usep}]] 50 40 70 55
  493.     set values [eval [concat dialog -w 330 -h 130  -b OK 20 100 85 120 -b Cancel 105 100 170 120 $box]]
  494.     # Interpret result
  495.     if {[lindex $values 1]} {error "Cancel"}
  496.     # work around a little Tcl problem
  497.     regsub "\{\{\}" $values "\\\{" values
  498.     set elemKey [string toupper [string trim [lindex $values [expr {6 + $option +$usep}]]]]
  499.     set special [lindex $values 2]
  500.     set keyStr ""
  501.     if {[lindex $values 3]} {append keyStr "<U"}
  502.     if {[lindex $values 4]} {append keyStr "<B"}
  503.     if {$option && [lindex $values [expr {5 + $usep}]]} {append keyStr "<I"}
  504.     if {[lindex $values [expr {5 + $option +$usep}]]} {append keyStr "<O"}
  505.     if {$usep} {
  506.         set pref [lindex $values 5]
  507.         if {$pref != "<none>"} {
  508.         set i [lsearch -exact $prefix $pref]
  509.         append keyStr "«[lindex $prefixes $i]»"
  510.         }
  511.     }
  512.     if {[string length $elemKey] > 1 && $special == "Normal key"} {
  513.         alertnote "You should only give one character for key binding."
  514.     } else {
  515.         if {$for_menu} {
  516.         if {$special == "Normal key" && [text::Ascii $elemKey] > 126} {
  517.             alertnote "Sorry, can't define a key binding with $elemKey."
  518.         } elseif {$elemKey != "" && $special == "Normal key" && ($keyStr == "" || $keyStr == "<U")} {
  519.             alertnote "You must choose at least one of the modifiers control, option and command."
  520.         } elseif {![regexp {F[0-9]} $special] && $special != "Tab" && $special != "Normal key" && $special != "<No binding>" && $keyStr == ""} {
  521.             alertnote "You must choose at least one modifier."
  522.         } else {
  523.             break
  524.         }
  525.         } else {
  526.         break
  527.         }
  528.     }
  529.     }
  530.     if {$special == "<No binding>"} {set elemKey ""}
  531.     if {$special != "Normal key" && $special != "<No binding>"} {
  532.     if {[set i [lsearch -exact $otherKeys $special]] != -1} {
  533.         set elemKey [lindex $otherKeyChars $i]
  534.     } else {
  535.         set elemKey [text::Ascii [expr {[lsearch -exact ${keys::func} $special] + 97}] 1]
  536.     }
  537.     }
  538.     if {![string length $elemKey]} {
  539.     set keyStr ""
  540.     } else {
  541.     append keyStr "/$elemKey"
  542.     }    
  543.     return $keyStr
  544. }
  545.  
  546. ## 
  547.  # -------------------------------------------------------------------------
  548.  # 
  549.  # "dialog::optionMenu" --
  550.  # 
  551.  #  names is the list of items.  An item '-' is a divider, and empty items
  552.  #  are not allowed.
  553.  # -------------------------------------------------------------------------
  554.  ##
  555. proc dialog::optionMenu {prompt names {default ""} {index 0}} {
  556.     if {$default == ""} {set default [lindex $names 0]}
  557.     
  558.     set y 5
  559.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  560.     if {[string length $prompt] > 60} { set w 500 }
  561.     
  562.     # in case we need a wide pop-up area that needs more room
  563.     set popUpWidth [expr {7 * [maxListItemLength $names]}]
  564.     set altWidth [expr {$popUpWidth + 60}]
  565.     set w [expr {$altWidth > $w ? $altWidth : $w}]
  566.     
  567.     set dialog [dialog::text $prompt 5 y [expr {$w /6}]]
  568.     incr y 10
  569.     eval lappend dialog [dialog::menu 30 y $names $default $popUpWidth]
  570.     incr y 20
  571.     eval lappend dialog [dialog::okcancel [expr {$w - 160}] y 0]
  572.     set res [eval dialog -w $w -h $y $dialog]
  573.     
  574.     if {[lindex $res 2]} { error "Cancel" } 
  575.     # cancel was pressed
  576.     if {$index} {
  577.     # we have to take out the entries correponding to pop-up 
  578.     # menu separator lines -trf
  579.     set possibilities [lremove -all $names "-"]
  580.     return [lsearch -exact $possibilities [lindex $res 0]]
  581.     } else {
  582.     return [lindex $res 0]
  583.     }
  584. }
  585.  
  586. ## 
  587.  # -------------------------------------------------------------------------
  588.  # 
  589.  # "dialog::alert" --
  590.  # 
  591.  #  Identical to 'alertnote' but copes with larger blocks of text, and
  592.  #  resizes to that text as appropriate.
  593.  # -------------------------------------------------------------------------
  594.  ##
  595. proc dialog::alert {args} {
  596.     eval [list dialog::yesno -y "Ok" -n ""] $args
  597. }
  598.  
  599. ## 
  600.  # -------------------------------------------------------------------------
  601.  # 
  602.  # "dialog::yesno" --
  603.  # 
  604.  #  Make a dialog with between 1 and 3 buttons, representing '1', '0' and
  605.  #  error "Cancel" respectively.  The names of the first two can be given
  606.  #  with '-y name' and '-n name' respectively.  The cancel button is
  607.  #  only used if a '-c' flag is given (and its name is fixed).
  608.  #  
  609.  #  The procedure automatically sizes the dialog and buttons to fit the
  610.  #  enclosed text.
  611.  # -------------------------------------------------------------------------
  612.  ##
  613. proc dialog::yesno {args} {
  614.     # too long for Alpha's standard dialog
  615.     getOpts {-y -n}
  616.     set prompt [lindex $args 0]
  617.     set y 5
  618.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  619.     if {[string length $prompt] > 60} { set w 500 }
  620.     
  621.     set dialog [dialog::text $prompt 5 y [expr {$w /6}]]
  622.     incr y 10
  623.     set x 10
  624.     if {[info exists opts(-y)] && $opts(-y) != ""} {
  625.     lappend buttons $opts(-y) "" y
  626.     } else {
  627.     lappend buttons "Yes" "" y
  628.     }
  629.     if {[info exists opts(-n)]} {
  630.     if {$opts(-n) != ""} {
  631.         lappend buttons $opts(-n) "" y
  632.     }
  633.     } else {
  634.     lappend buttons "No" "" y
  635.     }
  636.     if {[info exists opts(-c)]} {
  637.     lappend buttons "Cancel" "" y
  638.     }
  639.     eval lappend dialog [eval dialog::button $buttons]
  640.     if {$x > $w} { set w [expr {$x + 15}] }
  641.     set res [eval dialog -w $w -h $y $dialog]
  642.     if {[lindex $res 0]} {
  643.     return 1
  644.     } elseif {[lindex $res 1]} {
  645.     return 0
  646.     } else {
  647.     error "cancelled"
  648.     }
  649. }
  650.  
  651. proc dialog::password {{msg "Please enter password:"}} {
  652.     set values [dialog -w 300 -h 90 -t $msg 10 20 290 35 \
  653.       -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  654.     if {[lindex $values 2]} {error "Cancel"}
  655.     return [lindex $values 0]
  656. }
  657.  
  658. proc global::allPrefs {{which "AllPreferences"}} {
  659.     dialog::resetModified
  660.     global flagPrefs varPrefs
  661.     global::updateHelperFlags
  662.     global::updateMiscFlags
  663.     set AllPreferences [array names flagPrefs]
  664.     set InterfacePreferences {Tiling Window Wrapping Gui}
  665.     set StandardPreferences {Backups Electrics Miscellaneous Printer Tags WWW}
  666.     set OtherPreferences [lremove -l $AllPreferences \
  667.       $InterfacePreferences $StandardPreferences]
  668.     foreach nm [set [join ${which} ""]] {
  669.     lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  670.     }
  671.     dialog::is_global {
  672.     dialog::global_adjust_flags [dialog::multipage $args]
  673.     }
  674. }
  675.  
  676. proc dialog::preferences {menu nm} {
  677.     global flagPrefs varPrefs
  678.     if {[string match "Suffix Mappings" $nm]} {
  679.     return [suffixMappings]
  680.     } elseif {[string match "Menus And Features" $nm]} {
  681.     return [global::menusAndFeatures]
  682.     } elseif {[string match "Edit Prefs File" $nm]} {
  683.     return [global::editPrefsFile]
  684.     }
  685.     if {![info exists flagPrefs($nm)]} { 
  686.     set nm "[string toupper [string index $nm 0]][string range $nm 1 end]" 
  687.     }
  688.     if {[string match "*Preferences" $nm]} { return [global::allPrefs $nm] }
  689.     if {$nm == "Miscellaneous"} { global::updateMiscFlags }
  690.     if {$nm == "Helpers"} { global::updateHelperFlags }
  691.     dialog::is_global {
  692.     dialog::global_adjust_flags [dialog::onepage $flagPrefs($nm) $varPrefs($nm) "$nm preferences…"]
  693.     }
  694. }
  695.  
  696. # ◊◊◊◊ Finding applications ◊◊◊◊ #
  697.  
  698.  
  699. proc dialog::askFindApp {var sig} {
  700.     if {$sig == ""} {
  701.     set text "Currently unassigned.   Set?"
  702.     } elseif {[catch {nameFromAppl '$sig'} name]} {
  703.     set text "App w/ sig '$sig' doesn't seem to exist.   Change?"
  704.     } else {
  705.     set text "Current value is '$name'.   Change?"
  706.     }
  707.     if {[dialog::yesno $text]} {
  708.     set nsig [dialog::findApp $var $sig]
  709.     set app [nameFromAppl $nsig]
  710.     if {[dialog::yesno "Are you sure you want to set $var to '$nsig' (mapped to '$app')?"]} {
  711.         return $nsig
  712.     }
  713.     }
  714.     return ""
  715. }
  716.  
  717. proc dialog::findApp {var sig} {
  718.     global ${var}s modifiedVars
  719.     if {[info exists ${var}s]} {
  720.     # have a list of items
  721.     set sigs [set ${var}s]
  722.     
  723.     set s 0
  724.     foreach f $sigs {
  725.         if {![catch {nameFromAppl $f} path]} {
  726.         lappend items [file tail $path]
  727.         lappend itemsigs $f
  728.         incr s
  729.         }
  730.     }
  731.     if {$s} {
  732.         lappend items "-" "Locate manually…"
  733.         if {[catch {dialog::optionMenu "Select a new helper for '$var':" \
  734.           $items "" 1} p]} {
  735.         return ""
  736.         }
  737.         # we removed a bunch of items above, so have to look here
  738.         if {$p < $s} {
  739.         return [lindex $itemsigs $p]
  740.         }
  741.     }
  742.     if {!$s || $p >= $s} {
  743.         set nsig [dialog::_findApp $var $sig]
  744.         if {$nsig != ""} {
  745.         if {[lsearch $sigs $nsig] == -1} {
  746.             lappend ${var}s $nsig
  747.             lappend modifiedVars ${var}s
  748.         }
  749.         }
  750.     } else {
  751.         set nsig [lindex $sigs $p]
  752.     }
  753.     return $nsig
  754.     } else {
  755.     return [dialog::_findApp $var $sig]
  756.     }
  757. }
  758.  
  759. proc dialog::_findApp {var sig} {
  760.     if {[catch {getfile "Locate new helper for '$var':"} path]} { return "" }
  761.     set nsig [getFileSig $path]
  762.     set app [nameFromAppl $nsig]
  763.     if {$app != $path} {
  764.     alertnote "Appl sig '$nsig' is mapped to '$app', not '$path'. Remove the former, or rebuild your desktop."
  765.     return ""
  766.     }
  767.     return $nsig
  768. }
  769.  
  770. # ◊◊◊◊ Global/mode menus ◊◊◊◊ #
  771.  
  772. ## 
  773.  # -------------------------------------------------------------------------
  774.  # 
  775.  # "dialog::pickMenusAndFeatures" --
  776.  # 
  777.  #  Prompt the user to select menus and features either globally or
  778.  #  for a given mode.  We need to make sure that those items in
  779.  #  the mode-list which are also in the global list aren't forgotten
  780.  #  (since they are removed from the dialog).
  781.  # -------------------------------------------------------------------------
  782.  ##
  783. proc dialog::pickMenusAndFeatures {mode} {
  784.     global mode::features global::features 
  785.     set all [package::partition $mode]
  786.     set menus1 [lindex $all 0]
  787.     set menus2 [lindex $all 1]
  788.     set menus3 [lindex $all 2]
  789.     set features1 [lindex $all 3]
  790.     set features2 [lindex $all 4]
  791.     set features3 [lindex $all 5]
  792.     set all [eval concat $all]
  793.     # decide on two or three column
  794.     #set endw [expr [llength $all] > 50 ? 560 : 380]
  795.     set endw 560
  796.     set chosen ""
  797.     set notchosen ""
  798.     if {$mode == "global"} {
  799.     set current ${global::features}
  800.     set prefix "Select global #"
  801.     lappend names0 {Select global menus}
  802.     set types [list Usual "" "Other possible"]
  803.     } else {
  804.     foreach pkg [set current [set mode::features($mode)]] {
  805.         if {[lsearch -exact ${global::features} $pkg] != -1} {
  806.         lappend chosen $pkg
  807.         } else {
  808.         if {[string index $pkg 0] == "-"} {
  809.             set pkg [string range $pkg 1 end]
  810.             if {[lsearch -exact ${global::features} $pkg] != -1} {
  811.             # these are the ones which are disabled
  812.             lappend notchosen $pkg
  813.             }
  814.         }
  815.         }
  816.     }
  817.     set prefix "Select # for mode '$mode'"
  818.     lappend names0 "Select menus for mode '$mode'" 
  819.     set types [list Usual General "Other possible"]
  820.     }
  821.     set tmpcurrent $current
  822.     while 1 {
  823.     set maxh 0
  824.     set box ""
  825.     set names $names0
  826.     foreach type {menus features off} {
  827.         if {$mode == "global" && $type == "off"} {break}
  828.         set w 20
  829.         set h 45
  830.         set i 0
  831.         if {$type == "off"} {
  832.         set subm "Turn items off"
  833.         set types [list "Usually on for this mode" "Uncheck to disable"]
  834.         set off1 [lsort $chosen]
  835.         set off2 [lsort [lremove -l ${global::features} $chosen]]
  836.         set alloff [concat $off1 $off2]
  837.         } else {
  838.         regsub "\#" $prefix $type subm
  839.         }
  840.         set page 1
  841.         lappend names $subm
  842.         lappend box "-n" $subm
  843.         if {$type == "off"} {
  844.         lappend box -t "These items are currently globally on. You can turn them off just for this mode here."  10 $h [expr {$endw -20}] [expr {$h +15}]
  845.         incr h 20
  846.         }
  847.         foreach block $types {
  848.         incr i
  849.         if {[llength [set ${type}$i]] == 0} {
  850.             continue
  851.         }
  852.         if {$type == "off"} {
  853.             lappend box -t "$block:"
  854.         } else {
  855.             lappend box -t "$block $type:" 
  856.         }
  857.         lappend box 10 $h [expr {$w +160}] [expr {$h +15}]
  858.         incr h 20
  859.         foreach m [set ${type}$i] {
  860.             set name [quote::Prettify $m]
  861.             if {$type == "off"} {
  862.             set tick [expr {([lsearch -exact $notchosen $m] < 0)}]
  863.             } else {
  864.             set tick [expr {([lsearch -exact $tmpcurrent $m] >= 0)}]
  865.             }
  866.             lappend box -c $name $tick $w $h  [expr {$w + 160}] [expr {$h + 15}]
  867.             incr w 180
  868.             if {$w == $endw} {set w 20; incr h 20}
  869.             if {$h > 360} {
  870.             if {$h > $maxh} {set maxh $h}
  871.             incr page
  872.             lappend names "$subm page $page"
  873.             lappend box "-n" "$subm page $page"
  874.             set h 45
  875.             lappend box -t "$block $type continued..." 10 $h [expr {$w +260}] [expr {$h +15}]
  876.             incr h 20
  877.             }
  878.         }
  879.         if {$w != 20} {
  880.             incr h 30 ; set w 20
  881.         }
  882.         }
  883.         if {$h > $maxh} {set maxh $h}
  884.         
  885.     }
  886.     set h $maxh
  887.     incr h 20
  888.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  889.       -b OK 20 $h 85 [expr {$h + 20}] \
  890.       -b Cancel 105 $h 170 [expr {$h + 20}]  \
  891.       -b Help [expr {$endw -200}] $h [expr {$endw - 140}] [expr {$h + 20}] \
  892.       -b Descriptions [expr {$endw -120}] $h [expr {$endw -20}] [expr {$h + 20}] \
  893.       -m [list $names] [expr {($endw - 220)/2}] 10 $endw 30 $box]]
  894.     
  895.     set names0 [list [lindex $values 4]]
  896.     if {[lindex $values 0]} {break}
  897.     if {[lindex $values 1]} {return $current}
  898.     if {[lindex $values 2]} {
  899.         dialog::describeMenusAndFeatures Help
  900.     }
  901.     if {[lindex $values 3]} {
  902.         dialog::describeMenusAndFeatures Describe
  903.     }    
  904.     set tmpcurrent ""
  905.     for {set i 0} {$i < [llength $all]} {incr i} {
  906.         if {[lindex $values [expr {$i + 5}]]} {
  907.         lappend tmpcurrent [lindex $all $i]
  908.         }
  909.     }
  910.     }
  911.  
  912.     for {set i 0} {$i < [llength $all]} {incr i} {
  913.     if {[lindex $values [expr {$i + 5}]]} {lappend chosen [lindex $all $i]}
  914.     }
  915.     if {$mode != "global"} {
  916.     for {set j 0} {$j < [llength [set global::features]]} {incr i ; incr j} {
  917.         if {![lindex $values [expr {$i + 5}]]} {
  918.         # turned one off
  919.         set itm [lindex $alloff $j]
  920.         if {[set idx [lsearch -exact $chosen $itm]] != -1} {
  921.             set chosen [lreplace $chosen $idx $idx "-$itm"]
  922.         } else {
  923.             lappend chosen "-$itm"
  924.         }
  925.         } 
  926.     }
  927.     }
  928.     return $chosen
  929. }
  930.  
  931. proc dialog::describeMenusAndFeatures {{what "Help"}} {
  932.     set all [package::partition]
  933.     set okmenu [lindex $all 0]
  934.     set okfeature [lindex $all 1]
  935.     set okmode [lindex $all 2]
  936.     set all [eval concat $all]
  937.     # decide on two or three column
  938.     set endw [expr {[llength $all] > 50 ? 560 : 380}]
  939.     if {$what == "Help"} {
  940.     set prefix "Read help for a #"
  941.     } else {
  942.     set prefix "Describe a #"
  943.     }
  944.     foreach m {menu feature mode} {
  945.     regsub "\#" $prefix $m subm
  946.     lappend names $subm
  947.     }
  948.     lappend box -m [concat [list [lindex $names 0]] $names] \
  949.       [expr {($endw - 150)/2}] 10 $endw 30
  950.     set maxh 0
  951.     set wincr 160
  952.     foreach type {menu feature mode} {
  953.     set w 20
  954.     set h 45
  955.     regsub "\#" $prefix $type subm
  956.     lappend box "-n" $subm
  957.     if {$type == "mode"} {set wincr 70}
  958.     foreach m [set ok$type] {
  959.         set name [quote::Prettify $m]
  960.         lappend box -b $name $w $h [expr {$w + $wincr}] [expr {$h + 15}]
  961.         incr w [expr {$wincr +20}]
  962.         if {$w == $endw} {set w 20; incr h 20}
  963.     }
  964.     if {$w > 20} {set w 20; incr h 20}
  965.     if {$h > $maxh} {set maxh $h}
  966.     }
  967.     set h $maxh
  968.     incr h 20
  969.     while 1 {
  970.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  971.       -b OK 20 $h 85 [expr {$h + 20}] $box]]
  972.     if {[lindex $values 0]} {return}
  973.     # we hit a button
  974.     for {set i 0} {$i < [llength $all]} {incr i} {
  975.         if {[lindex $values [expr {$i + 2}]]} {
  976.         if {$what == "Help"} {
  977.             package::helpFile [lindex $all $i]
  978.         } else {
  979.             package::describe [lindex $all $i]
  980.         }
  981.         break
  982.         }
  983.     }
  984.     }
  985. }
  986.  
  987.  
  988. # ◊◊◊◊ Dialog sub-panes ◊◊◊◊ #
  989.  
  990. set dialog::_not_global_flag ""
  991.  
  992. ## 
  993.  # -------------------------------------------------------------------------
  994.  # 
  995.  # "dialog::flag" --
  996.  # 
  997.  #  Builds a dialog-box page to be used for setting global/mode/package
  998.  #  preferences.  It can contain preferences for flags (on/off), variables,
  999.  #  list items, mode items, files, folders, apps,...
  1000.  # 
  1001.  # Results:
  1002.  #  part of a script to generate the dialog
  1003.  # 
  1004.  # Side effects:
  1005.  #  sets maxT to the maximum height desired by the dialog
  1006.  # 
  1007.  # --Version--Author------------------Changes-------------------------------
  1008.  #    1.0     Pete Keleher             original
  1009.  #    2.0     <darley@fas.harvard.edu> much more sophisticated (and complex!)
  1010.  # -------------------------------------------------------------------------
  1011.  ##
  1012. proc dialog::flag {flags vars {left 20} {top 40} {title {}}} {
  1013.     global maxT spelling alpha::prefNames dialog::_not_global_flag mode
  1014.     if {[info tclversion] >= 8.0} {
  1015.     cache::read index::prefshelp
  1016.     upvar help help
  1017.     if {[regsub {(modeVars)?$} [set vprefix ${dialog::_not_global_flag}] "" vprefix]} {
  1018.         append vprefix ","
  1019.     }
  1020.     }
  1021.     
  1022.     if {$title != ""} {
  1023.     lappend args "-t" $title 30 10 400 25
  1024.     incr top 25
  1025.     }
  1026.     # if variable names are very long, switch to 2 columns
  1027.     if {[maxListItemLength $flags] > 18} {
  1028.     set perRow 2
  1029.     set width 225
  1030.     } else {
  1031.     set perRow 3
  1032.     set width 150
  1033.     }
  1034.     set height    15
  1035.     
  1036.     set ind 0
  1037.     set l $left
  1038.     foreach f $flags {
  1039.     set fname [quote::Prettify $f]
  1040.     if {$spelling} {text::british fname}
  1041.     lappend args "-c" $fname [dialog::getFlag $f] \
  1042.       $l $top [incr l $width] [expr {$top + $height}]
  1043.     if {[incr ind] % $perRow == 0} { set l $left ; incr top $height }
  1044.     if {[info tclversion] >= 8.0} {
  1045.         if {[info exists prefshelp($vprefix$f)]} {
  1046.         lappend help $prefshelp($vprefix$f)
  1047.         } elseif {[info exists prefshelp($mode,$f)]} {
  1048.         lappend help $prefshelp($mode,$f)
  1049.         } else {
  1050.         lappend help ""
  1051.         }
  1052.     }
  1053.     }
  1054.     
  1055.     if {$ind} {
  1056.     set top [expr {$top + 20}]
  1057.     lappend args -p 100 [expr {$top + 27}] 300 [expr {$top + 28}]
  1058.     } 
  1059.     
  1060.     dialog::buildSection $vars top 440 $left args alpha::prefNames
  1061.     incr top 30
  1062.     
  1063.     if {$top > $maxT} {set maxT $top}
  1064.     return $args
  1065. }
  1066.  
  1067. ## 
  1068.  # -------------------------------------------------------------------------
  1069.  # 
  1070.  # "dialog::buildSection" --
  1071.  # 
  1072.  #  Build a dialog box section for a bunch of preferences.  If 'flag_check'
  1073.  #  is set the prefs can be flags or vars, else just vars.
  1074.  #  
  1075.  #  'yvar' is a variable which contains the current y-pos in the box,
  1076.  #  and should be incremented as appropriate by this procedure.
  1077.  #  'width' is the width of the dialog box (default 420)
  1078.  #  'l' is the left indent of all the items (default 20)
  1079.  #  'dialogvar' is the variable onto which all the construction code
  1080.  #  should be lappended.  If it is not given, then this proc will
  1081.  #  return the items.
  1082.  #  'names', if given, is an array containing textual replacements for
  1083.  #  the names of the variables to be used in the box.
  1084.  #  
  1085.  #  A minimal call would be:
  1086.  #  
  1087.  #  set y 20
  1088.  #  set build [dialog::buildSection [list fillColumn] y]
  1089.  #  eval lappend build [dialog::okcancel 20 y]
  1090.  #  set res [eval dialog -w 480 -h $y $build]
  1091.  #  
  1092.  # -------------------------------------------------------------------------
  1093.  ##
  1094. proc dialog::buildSection {vars yvar {width 420} {l 20} {dialogvar ""} {names ""} {flag_check 1}} {
  1095.     global flag::list flag::type allFlags spelling alpha::colors mode::features \
  1096.       includeDescriptionsInDialogs dialog::_not_global_flag mode
  1097.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  1098.     cache::read index::prefshelp
  1099.     if {[info tclversion] >= 8.0} {
  1100.         upvar help help
  1101.     }
  1102.     }
  1103.     if {[regsub {(modeVars)?$} [set vprefix ${dialog::_not_global_flag}] "" vprefix]} {
  1104.     append vprefix ","
  1105.     }
  1106.     upvar $yvar t
  1107.     if {$dialogvar != ""} {upvar $dialogvar args}
  1108.     if {$names != ""} { upvar $names name }
  1109.     set height 17
  1110.     set lf 135
  1111.     set r [expr {$l + $width}]
  1112.     set rb [expr {$r -45}]
  1113.     foreach vset $vars {
  1114.     if {[llength $vset] > 1} {
  1115.         incr t 5
  1116.         if {[lindex $vset 0] != ""} {
  1117.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1118.         incr t 20
  1119.         }
  1120.         set vset [lrange $vset 1 end]
  1121.     }
  1122.     foreach v $vset {
  1123.         if {$includeDescriptionsInDialogs} {
  1124.         if {[info exists prefshelp($vprefix$v)]} {
  1125.             eval lappend args [dialog::text $prefshelp($vprefix$v) $l t]
  1126.         }
  1127.         }
  1128.         if {[info tclversion] >= 8.0} {
  1129.         if {[info exists prefshelp($vprefix$v)]} {
  1130.             lappend help $prefshelp($vprefix$v)
  1131.         } elseif {[info exists prefshelp($mode,$v)]} {
  1132.             lappend help $prefshelp($mode,$v)
  1133.         } else {
  1134.             lappend help ""
  1135.         }
  1136.         }
  1137.         
  1138.         set vv [dialog::getFlag $v]
  1139.         if {[info exists name($v)]} {
  1140.         set vname $name($v)
  1141.         } else {
  1142.         set vname [quote::Prettify $v]
  1143.         }
  1144.         if {$spelling} {
  1145.         text::british vname
  1146.         }
  1147.         if {$flag_check && [lcontains allFlags $v]} {
  1148.         lappend args "-c" $vname $vv $l $t $r [expr {$t + 15}]
  1149.         incr t 15
  1150.         continue
  1151.         }
  1152.         # attempt to indent correctly
  1153.         set len [string length $vname] 
  1154.         if {$len > 40} {
  1155.         lappend args "-t" "$vname:" $l $t [expr {$r -30}] [expr {$t + $height}]
  1156.         incr t 15
  1157.         set indent 100
  1158.         set tle ""
  1159.         } elseif {$len > 17} {
  1160.         set indent [expr {31 + 7 * $len}]
  1161.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1162.         } else {
  1163.         set indent $lf
  1164.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1165.         }
  1166.         
  1167.         if {[info exists flag::list($v)]} {
  1168.         incr t 5
  1169.         eval lappend args $tle
  1170.         set litems [flag::options $v]
  1171.         if {[regexp "index" [lindex [set flag::list($v)] 0]]} {
  1172.             # set item to index, making sure bad values don't error
  1173.             if {[catch {lindex $litems $vv} vv]} { set vv [lindex $litems 0] }
  1174.         }
  1175.         lappend args "-m" [concat [list $vv] $litems] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1176.         incr t 17
  1177.         } elseif {[regexp "Colou?r$" $v]} {
  1178.         incr t 5
  1179.         eval lappend args $tle
  1180.         lappend args "-m" [concat [list $vv] ${alpha::colors}] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1181.         incr t 17
  1182.         } elseif {[regexp "Mode$" $v]} {
  1183.         incr t 5
  1184.         eval lappend args $tle
  1185.         if {$vv == ""} { set vv "<none>" }
  1186.         lappend args "-m" [concat [list $vv] [concat "<none>" [lsort [array names mode::features]]]] [expr {$l + $indent -2}] $t [expr {$r - 14}] [expr {$t + $height +1}]
  1187.         incr t 17
  1188.         } elseif {[regexp "Sig$" $v]} {
  1189.         eval lappend args $tle
  1190.         set vv [dialog::specialView_Sig $vv]
  1191.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1192.         eval lappend args [dialog::buttonSet $rb $t]
  1193.         incr t 17
  1194.         } elseif {[regexp "SearchPath$" $v]} {
  1195.         eval lappend args $tle
  1196.         if {$vv == ""} {
  1197.             lappend args "-t" "No search paths currently set." \
  1198.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1199.             eval lappend args [dialog::buttonSet $rb $t]
  1200.             incr t 17
  1201.         } else {
  1202.             eval lappend args [dialog::buttonSet $rb $t]
  1203.             foreach ppath $vv {
  1204.             lappend args "-t" [dialog::specialView_file $ppath] \
  1205.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1206.             incr t 17
  1207.             }
  1208.         }
  1209.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1210.         eval lappend args $tle
  1211.         set vv [dialog::specialView_file $vv]
  1212.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1213.         eval lappend args [dialog::buttonSet $rb $t]
  1214.         incr t 17
  1215.         } elseif {[info exists flag::type($v)]} {
  1216.         eval lappend args $tle
  1217.         set vv [dialog::specialView_[set flag::type($v)] $vv]
  1218.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1219.         eval lappend args [dialog::buttonSet $rb $t]            
  1220.         incr t 17
  1221.         } else {
  1222.         set eh [expr {1 + [string length $vv] / 60}]
  1223.         incr t [expr {7 * $eh}]
  1224.         eval lappend args $tle
  1225.         incr t [expr {5 -7 * $eh}]
  1226.         lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1227.         incr t [expr {5 + 17 * $eh}]
  1228.         }
  1229.     }
  1230.     }
  1231.     if {$dialogvar == ""} {return $args}
  1232. }
  1233. proc dialog::multipage {data} {
  1234.     dialog::resetModified
  1235.     global maxT
  1236.     # in case internal 'command-buttons' are used in the dialog
  1237.     while 1 {
  1238.     
  1239.     set left 20   
  1240.     
  1241.     set names {}
  1242.     set editItems {}
  1243.     set cmd ""
  1244.     set maxT 0
  1245.     foreach arg [lsort $data] {
  1246.         if {[llength $arg] != 3} {error "Bad structure"}
  1247.         lappend names [lindex $arg 0]
  1248.         set flags [lindex $arg 1]
  1249.         set vars [lindex $arg 2]
  1250.         lappend editItems [eval list $flags $vars]
  1251.         eval lappend cmd "-n" [list [lindex $arg 0]] [dialog::flag $flags $vars]
  1252.     }
  1253.     
  1254.     set buttons [dialog::okcancel $left maxT]
  1255.     set height $maxT
  1256.     if {![info exists chosenName]} {set chosenName [lindex $names 0]}
  1257.     if {[info exists help]} {
  1258.         set res [eval [concat dialog -w 480 -h $height \
  1259.           -t "Preferences:" 60 10 140 30 $buttons \
  1260.           -b "Help" 410 10 460 28 \
  1261.           [list -m [concat [list $chosenName] $names] 150 10 405 30] \
  1262.           $cmd -help] [list [concat [list \
  1263.           "Click here to save the current settings." \
  1264.           "Click here to discard any changes you've made to the settings." "Help" \
  1265.           "Use this popup menu, or the cursor keys to select a \
  1266.           different page of preferences."] $help]]]
  1267.     } else {
  1268.         set res [eval [concat dialog -w 480 -h $height \
  1269.           -t "Preferences:" 60 10 140 30 $buttons \
  1270.           -b "Help" 410 10 460 28 \
  1271.           [list -m [concat [list $chosenName] $names] 150 10 405 30] \
  1272.           $cmd]]
  1273.     }
  1274.     
  1275.     set chosenName [lindex $res 3]
  1276.     if {[lindex $res 0]} {
  1277.         return [list [lrange $res 4 end] [eval concat $editItems]]
  1278.     } else {
  1279.         if {[lindex $res 1]} {
  1280.         error "Cancel chosen"
  1281.         }
  1282.         dialog::rememberChanges [list [lrange $res 4 end] [eval concat $editItems]]
  1283.         # Either help, or some set or describe type button was pressed
  1284.         # We need to ensure we remember anything the user has already
  1285.         # changed.
  1286.         if {[lindex $res 2]} {
  1287.         # help pressed
  1288.         set i [lsearch -exact $names [lindex $res 3]]
  1289.         dialog::describe [lindex $editItems $i] "Description of [lindex $res 3] prefs"
  1290.         } else {
  1291.         # a 'set…' button was pressed
  1292.         dialog::handleSet [lrange $res 4 end] [eval concat $editItems]
  1293.         }
  1294.     }
  1295.     # end of large while loop
  1296.     }
  1297.  
  1298. }
  1299.  
  1300. proc dialog::rememberChanges {values_items} {
  1301.     set res [lindex $values_items 0]
  1302.     set editItems [lindex $values_items 1]
  1303.     unset values_items
  1304.     foreach fset $editItems {
  1305.     if {[llength $fset] > 1} {
  1306.         set fset [lrange $fset 1 end]
  1307.     }
  1308.     foreach flag $fset {
  1309.         set val [lindex $res 0]
  1310.         set res [lrange $res 1 end]
  1311.         dialog::postManipulate
  1312.         dialog::modified $flag $val
  1313.     }
  1314.     }
  1315. }
  1316.  
  1317. proc dialog::onepage {flags vars {title ""}} {
  1318.     dialog::resetModified
  1319.     global maxT
  1320.     while 1 {
  1321.     set left 20
  1322.     set maxT 0
  1323.     set args [dialog::flag $flags $vars 20 10 $title]
  1324.     set height [expr {$maxT + 30}]
  1325.     set buttons [dialog::okcancel $left maxT]
  1326.     set height $maxT
  1327.     if {[info exists help]} {
  1328.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1329.           -b "Help" 410 10 460 28 $args -help] \
  1330.           [list [concat [list \
  1331.           "Click here to save the current settings." \
  1332.           "Click here to discard any changes you've made to the settings." "Help" \
  1333.           ] $help]]]
  1334.     } else {
  1335.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1336.           -b "Help" 410 10 460 28 $args]]]
  1337.     }
  1338.     
  1339.     if {[lindex $res 0]} {
  1340.         return [list [lrange $res 3 end] [concat $flags $vars]]
  1341.     } else {
  1342.         
  1343.         if {[lindex $res 1]} {
  1344.         error "Cancel chosen"
  1345.         } 
  1346.         dialog::rememberChanges [list [lrange $res 3 end] [concat $flags $vars]]
  1347.         if {[lindex $res 2]} {
  1348.         # help
  1349.         dialog::describe [concat $flags $vars] $title
  1350.         } else {
  1351.         dialog::handleSet [lrange $res 3 end] [concat $flags $vars]
  1352.         }
  1353.     }
  1354.     # big while loop end
  1355.     }
  1356.     
  1357. }
  1358.  
  1359. proc dialog::describe {vars {title ""}} {
  1360.     if {$title == ""} {
  1361.     set title "Preferences description"
  1362.     }
  1363.     global flag::list flag::type spelling alpha::colors \
  1364.       dialog::_not_global_flag mode
  1365.     if {[regsub {(modeVars)?$} [set vprefix ${dialog::_not_global_flag}] "" vprefix]} {
  1366.     append vprefix ","
  1367.     }
  1368.     cache::read index::prefshelp
  1369.     set height 17
  1370.     set lf 135
  1371.     set l 20
  1372.     set width 420
  1373.     set r [expr {$l + $width}]
  1374.     set rb [expr {$r -45}]
  1375.     set args {}
  1376.     set t 35
  1377.     set height 0
  1378.     set page 1
  1379.     set pages {}
  1380.     foreach vset $vars {
  1381.     if {[llength $vset] > 1} {
  1382.         incr t 5
  1383.         if {[lindex $vset 0] != ""} {
  1384.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1385.         incr t 20
  1386.         }
  1387.         set vset [lrange $vset 1 end]
  1388.     } else {
  1389.         #do this so that vars that have whitespace padding (used to force dialog position)
  1390.         # are not strip of that space in the next "foreach" statement
  1391.         set vset [list [set vset]]
  1392.     }
  1393.     foreach v $vset {
  1394.         set vv [dialog::getFlag $v]
  1395.         if {[info exists name($v)]} {
  1396.         set vname $name($v)
  1397.         } else {
  1398.         set vname [quote::Prettify $v]
  1399.         }
  1400.         if {$spelling} {
  1401.         text::british vname
  1402.         }
  1403.         if {[info exists prefshelp($vprefix$v)]} {
  1404.         append vname ": " [dialog::helpdescription $prefshelp($vprefix$v)]
  1405.         } elseif {[info exists prefshelp($mode,$v)]} {
  1406.         append vname ": " [dialog::helpdescription $prefshelp($mode,$v)]
  1407.         } else {
  1408.         append vname ": no description"
  1409.         }
  1410.         eval lappend args [dialog::text $vname $l t 60]
  1411.         if {$t > 360} {
  1412.         # make another page
  1413.         eval lappend pages -n [list "Page $page"] $args
  1414.         set args {}
  1415.         incr page
  1416.         if {$t > $height} {set height $t}
  1417.         set t 35
  1418.         }
  1419.         
  1420.     }
  1421.     
  1422.     }
  1423.     if {$page > 1} {
  1424.     set t $height
  1425.     set height [expr {$t + 40}]
  1426.     for {set i 1} {$i <= $page} {incr i} {
  1427.         lappend names "Page $i"
  1428.     }
  1429.     eval lappend pages -n [list "Page $page"] $args        
  1430.     set res [eval [concat dialog -w 480 -h $height \
  1431.       -t [list $title] 60 10 $width 30 \
  1432.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] \
  1433.       [list -m [concat [list [lindex $names 0]] $names] 400 10 475 30] $pages]]
  1434.     } else {
  1435.     set height [expr {$t + 40}]
  1436.     set res [eval [concat dialog -w 480 -h $height \
  1437.       -t [list $title] 60 10 $width 30 \
  1438.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] $args]]
  1439.     }
  1440. }
  1441.  
  1442. proc dialog::helpdescription {hlp} {
  1443.     set hlp [split $hlp |]
  1444.     if {[llength $hlp] <= 1} {
  1445.     return [lindex $hlp 0]
  1446.     }
  1447.     set res ""
  1448.     for {set hi 0} {$hi < [llength $hlp]} {incr hi} {
  1449.     set hitem [lindex $hlp $hi]
  1450.     if {$hitem != ""} {
  1451.         if {$hi == 0} {
  1452.         regsub "click this box\\.?" $hitem "turn this item on" hitem
  1453.         } elseif {$hi == 2} {
  1454.         regsub "click this box\\.?" $hitem "turn this item off" hitem
  1455.         }
  1456.         append res $hitem ". "
  1457.     }
  1458.     }
  1459.     return $res
  1460. }
  1461.  
  1462. # ◊◊◊◊ Dialog utilities ◊◊◊◊ #
  1463. proc dialog::handleSet {res names} {
  1464.     # to account for sub-lists in the list of names
  1465.     foreach n $names {
  1466.     if {[llength $n] > 1} {
  1467.         eval lappend newnames [lrange $n 1 end]
  1468.     } else {
  1469.         lappend newnames $n
  1470.     }
  1471.     }
  1472.     set names $newnames
  1473.     unset newnames
  1474.     global flag::type
  1475.     # a 'set…' button was pressed
  1476.     for {set i 0} {$i < [llength $names]} {incr i} {
  1477.     if {[lindex $res $i] == 1} {
  1478.         set v [lindex $names $i]
  1479.         if {[regexp "SearchPath$" $v]} {
  1480.         set res [buttonAlert "Perform what action to one of the [quote::Prettify $v]s" "Add" "Remove" "Change" "Cancel"]
  1481.         switch -- $res {
  1482.             "Add" {
  1483.             # this set… pressed
  1484.             if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1485.                 set newval [concat [dialog::getFlag $v] [list $newval]] 
  1486.                 dialog::modified $v $newval
  1487.             }
  1488.             }
  1489.             "Remove" {
  1490.             if {![catch {set remove [listpick -p "Remove which items from [quote::Prettify $v]:" -l [dialog::getFlag $v]]}]} {
  1491.                 # remove them
  1492.                 set newval [lremove -l [dialog::getFlag $v] $remove] 
  1493.                 dialog::modified $v $newval
  1494.             }
  1495.             }
  1496.             "Change" {
  1497.             if {![catch {set change [listpick -p "Change which item from [quote::Prettify $v]:" [dialog::getFlag $v]]}]} {
  1498.                 # change it
  1499.                 if {![catch {get_directory -p "Replacement [quote::Prettify $v]:"} newval]} {
  1500.                 set old [dialog::getFlag $v]
  1501.                 set i [lsearch -exact $old $change]
  1502.                 set old [lreplace $old $i $i $newval]
  1503.                 dialog::modified $v $old
  1504.                 }
  1505.             }
  1506.             }
  1507.         }
  1508.         break
  1509.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1510.         # this set… pressed
  1511.         if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1512.             dialog::modified $v $newval
  1513.         }
  1514.         break
  1515.         } elseif {[info exists flag::type($v)]} {
  1516.         dialog::specialSet_[set flag::type($v)] $v
  1517.         break
  1518.         } elseif {[regexp "Sig$" $v]} {
  1519.         global $v
  1520.         set newval [dialog::findApp $v [set $v]]
  1521.         if {$newval != ""} {
  1522.             dialog::modified $v $newval
  1523.         }
  1524.         break
  1525.         }  
  1526.     }
  1527.     }
  1528. }
  1529.  
  1530. proc dialog::setFlag {name val} {
  1531.     global dialog::_not_global_flag
  1532.     if {${dialog::_not_global_flag} != ""} {
  1533.     global ${dialog::_not_global_flag}
  1534.     set ${dialog::_not_global_flag}($name) $val
  1535.     } else {
  1536.     global $name
  1537.     set $name $val
  1538.     }    
  1539. }
  1540.  
  1541. proc dialog::getFlag {name} {
  1542.     global dialog::_modified
  1543.     if {[info exists dialog::_modified($name)]} { 
  1544.     return [set dialog::_modified($name)] 
  1545.     } else {
  1546.     return [dialog::getOldFlag $name]
  1547.     }
  1548. }
  1549. proc dialog::getOldFlag {name} {
  1550.     global dialog::_not_global_flag
  1551.     if {${dialog::_not_global_flag} != ""} {
  1552.     global ${dialog::_not_global_flag}
  1553.     return [set ${dialog::_not_global_flag}($name)]
  1554.     } else {
  1555.     global dialog::_is_global
  1556.     if {[info exists dialog::_is_global]} {
  1557.         global global::_vars
  1558.         if {[info exists global::_vars] \
  1559.           && [set i [lsearch ${global::_vars} $name]] != -1} {
  1560.         return [lindex ${global::_vars} [incr i]]
  1561.         } 
  1562.     }
  1563.     }    
  1564.     global $name
  1565.     if {[info exists $name]} { 
  1566.     return [set $name]
  1567.     } else { 
  1568.     alertnote "Global variable '$name' in the dialog isn't set.\r\
  1569.       I'll try to fix that."
  1570.     return [set $name ""]
  1571.     }
  1572. }
  1573.  
  1574. proc dialog::is_global {script} {
  1575.     global dialog::_is_global
  1576.     set dialog::_is_global 1
  1577.     catch "[list uplevel $script]"
  1578.     unset dialog::_is_global
  1579. }
  1580. proc dialog::resetModified {} {
  1581.     global dialog::_modified
  1582.     catch {unset dialog::_modified}
  1583. }
  1584.  
  1585. proc dialog::global_adjust_flags {values_items} {
  1586.     global flag::procs modifiedVars global::_vars
  1587.     set res [lindex $values_items 0]
  1588.     set editItems [lindex $values_items 1]
  1589.     unset values_items
  1590.     foreach fset $editItems {
  1591.     if {[llength $fset] > 1} {
  1592.         set fset [lrange $fset 1 end]
  1593.     }
  1594.     foreach flag $fset {
  1595.         set val [lindex $res 0]
  1596.         set res [lrange $res 1 end]
  1597.         dialog::postManipulate
  1598.         if {[info exists global::_vars] \
  1599.           && [set i [lsearch ${global::_vars} $flag]] != -1} {
  1600.         set orig [lindex ${global::_vars} [incr i]]
  1601.         if {$orig != $val} {
  1602.             set global::_vars [lreplace ${global::_vars} $i $i $val]
  1603.             lappend warn_global $flag
  1604.         }
  1605.         } else {
  1606.         global $flag
  1607.         set orig [set $flag]
  1608.         if {$orig != $val} {
  1609.             set $flag $val
  1610.         }
  1611.         }
  1612.         if {$orig != $val} {
  1613.         if {[info exists flag::procs($flag)]} {
  1614.             set proc [set flag::procs($flag)]
  1615.             if {([info procs $proc] != "") && ([llength [info args $proc]] == 0)} {
  1616.             eval $proc
  1617.             } else {
  1618.             eval $proc [list $flag]
  1619.             }
  1620.         }
  1621.         lappend modifiedVars $flag
  1622.         }
  1623.     }
  1624.     }
  1625.     if {[info exists warn_global]} {
  1626.     if {[llength $warn_global] == 1} {
  1627.         set msg "is a global pref"
  1628.     } else {
  1629.         set msg "are global prefs"
  1630.     }
  1631.     alertnote "You modified [join $warn_global {, }] which $msg,\
  1632.       but currently over-ridden by mode-specific values.  If you meant to\
  1633.       modify the latter values, use the mode prefs dialog."
  1634.     }
  1635. }
  1636.  
  1637. proc dialog::postManipulate {} {
  1638.     global flag::list flag::type
  1639.     upvar flag f
  1640.     upvar val v
  1641.     
  1642.     if {[info exists flag::list($f)]} {
  1643.     switch -- [lindex [set l [set flag::list($f)]] 0] {
  1644.         "index" {
  1645.         set v [lsearch -exact [lindex $l 1] $v]
  1646.         }
  1647.         "varindex" {
  1648.         set itemv [lindex $l 1]
  1649.         global $itemv
  1650.         set v [lsearch -exact [set $itemv] $v]
  1651.         }
  1652.     }
  1653.     }
  1654.     if {$v == "<none>" && [regexp "Mode$" $f]} { set v "" }
  1655.     # This check also captures any 'dialog::modified' items
  1656.     # This allows flags which are somehow already set by the
  1657.     # dialog (for instance if called recursively, or if set by embedded
  1658.     # 'Set…' buttons) to be registered as modifed by our calling procedure.
  1659.     if {[regexp "(Path|Folder|Sig)$" $f]} {
  1660.     set v [dialog::getFlag $f]
  1661.     } elseif {[info exists flag::type($f)]} {
  1662.     switch -- [set flag::type($f)] {
  1663.         "binding" {
  1664.         # setup the changed binding
  1665.         set old [dialog::getOldFlag $f]
  1666.         set v [dialog::getFlag $f]
  1667.         if {$old != $v} {
  1668.             global flag::binding
  1669.             if {[info exists flag::binding($f)]} {
  1670.             set m [lindex [set flag::binding($f)] 0]
  1671.             if {[set proc [lindex [set flag::binding($f)] 1]] == 1} {
  1672.                 set proc $f
  1673.             }
  1674.             catch "unBind [keys::toBind $old] [list $proc] $m"
  1675.             catch "Bind [keys::toBind $v] [list $proc] $m"
  1676.             }
  1677.         }
  1678.         }
  1679.         default {
  1680.         set v [dialog::getFlag $f]
  1681.         }
  1682.     }
  1683.     }
  1684. }
  1685.  
  1686. proc dialog::modified {name val} {
  1687.     global dialog::_modified
  1688.     set dialog::_modified($name) $val
  1689. }
  1690.  
  1691. # Used on modified mode flags.
  1692. set flag::procs(stringColor) "stringColorProc"
  1693. set flag::procs(commentColor) "stringColorProc"
  1694. set flag::procs(keywordColor) "stringColorProc"
  1695. set flag::procs(funcColor) "stringColorProc"
  1696. set flag::procs(sectionColor) "stringColorProc"
  1697. set flag::procs(bracesColor) "stringColorProc"
  1698.  
  1699. proc global::updateHelperFlags {} {
  1700.     uplevel #0 {
  1701.     set flagPrefs(Helpers) {}
  1702.     set varPrefs(Helpers) [info globals *Sig]
  1703.     }
  1704. }
  1705.  
  1706. proc global::updateMiscFlags {} {
  1707.     global flagPrefs varPrefs allFlags modeVars allVars
  1708.     # flags can be in either flagPrefs or varPrefs if we're grouping
  1709.     # preferences according to function
  1710.     set all {}
  1711.     set flagPrefs(Miscellaneous) {}
  1712.     set varPrefs(Miscellaneous) {}
  1713.     foreach v [array names flagPrefs] {
  1714.     eval lappend all $flagPrefs($v)
  1715.     if {[regexp {[{}]} $varPrefs($v)]} {
  1716.         # we're grouping
  1717.         foreach i $varPrefs($v) {
  1718.         if {[llength $i] > 1} {
  1719.             eval lappend all [lrange $i 1 end]
  1720.         } else {
  1721.             lappend all $i
  1722.         }
  1723.         }
  1724.     } else {
  1725.         eval lappend all $varPrefs($v)
  1726.     }
  1727.     }
  1728.     foreach f $allFlags {
  1729.     if {([lsearch $modeVars $f] < 0)} {
  1730.         if {[lsearch -exact $all $f] == -1} {
  1731.         lappend flagPrefs(Miscellaneous) $f
  1732.         }
  1733.     }
  1734.     }
  1735.     
  1736.     foreach f $allVars {
  1737.     if {([lsearch $modeVars $f] < 0)} {
  1738.         if {[lsearch -exact $all $f] == -1} {
  1739.         if {[regexp {Sig$} $f]} {
  1740.             lappend varPrefs(Helpers) $f
  1741.         } else {
  1742.             lappend varPrefs(Miscellaneous) $f
  1743.         }
  1744.         }
  1745.     }
  1746.     }
  1747. }
  1748.  
  1749. #================================================================================
  1750.  
  1751. proc maxListItemLength {l} {
  1752.     set m 0
  1753.     foreach item $l {
  1754.     if {[set mm [string length $item]] > $m} { set m $mm }
  1755.     }
  1756.     return $m
  1757. }
  1758.  
  1759. proc stringColorProc {flag} {
  1760.     global $flag mode
  1761.     
  1762.     if {[set $flag] == "none"} {
  1763.         set $flag "foreground"
  1764.     }
  1765.     if {$flag == "stringColor"} {
  1766.         regModeKeywords -a -s $stringColor $mode
  1767.     } elseif {$flag == "commentColor"} {
  1768.         regModeKeywords -a -c $commentColor $mode
  1769.     } elseif {$flag == "funcColor"} {
  1770.         regModeKeywords -a -f $funcColor $mode
  1771.     } elseif {$flag == "bracesColor"} {
  1772.         regModeKeywords -a -I $bracesColor $mode
  1773.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  1774.         alertnote "Change in keyword color will take effect after Alpha restarts."
  1775.         return
  1776.     } else {
  1777.         alertnote "Change in $flag color will take effect after Alpha restarts."
  1778.         return
  1779.     }
  1780.     refresh
  1781. }
  1782.  
  1783. # ◊◊◊◊ Dialog sub-items ◊◊◊◊ #
  1784.  
  1785. proc dialog::buttonSet {x y} {
  1786.     return [list -b Set… $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1787. }
  1788.  
  1789. proc dialog::okcancel {x yy {vertical 0}} {
  1790.     upvar $yy y
  1791.     set i [dialog::button "OK" $x y]
  1792.     if {!$vertical} {
  1793.     incr y -30
  1794.     incr x 80
  1795.     }
  1796.     eval lappend i [dialog::button "Cancel" $x y]
  1797.     return $i
  1798. }
  1799.  
  1800. proc dialog::menu {x yy item {def "def"} {requestedWidth 0}} { 
  1801.     upvar $yy y
  1802.     set m [concat [list $def] $item]
  1803.     if {$requestedWidth == 0} {
  1804.     set popUpWidth 340
  1805.     } else {
  1806.     set popUpWidth $requestedWidth 
  1807.     }
  1808.     
  1809.     set res [list -m $m  $x $y [expr {$x + $popUpWidth}] [expr {$y +20}]]
  1810.     incr y 20
  1811.     return $res
  1812. }
  1813. ## 
  1814.  # -------------------------------------------------------------------------
  1815.  # 
  1816.  # "dialog::button" --
  1817.  # 
  1818.  #  Create a dialog string encoding one or more buttons.  'name' is the
  1819.  #  name of the button ("Ok" etc), x is the x position, or if x is null,
  1820.  #  then we use the variable called 'x' in the calling procedure.  yy is
  1821.  #  the name of a variable containing the y position of the button, which
  1822.  #  will be incremented by this procedure.  if args is non-null, it
  1823.  #  contains further name-x-yy values to be lines up next to this button.
  1824.  #  For sequences of default buttons, a spacing of '80' is usual, but
  1825.  #  it's probably best if you just set the 'x' param to "" and let this
  1826.  #  procedure calculate them for you.  See dialog::yesno for a good
  1827.  #  example of calling this procedure.
  1828.  # -------------------------------------------------------------------------
  1829.  ##
  1830. proc dialog::button {name x yy args} { 
  1831.     upvar $yy y
  1832.     if {$x == ""} {
  1833.     unset x
  1834.     upvar x x
  1835.     }
  1836.     set add 65
  1837.     if {[set i [expr {[string length $name] - 7}]] > 0} { 
  1838.     incr add [expr {$i * 7}]
  1839.     }
  1840.     set res [list -b $name $x $y [expr {$x +$add}] [expr {$y +20}]]
  1841.     incr x $add
  1842.     incr x 15
  1843.     if {[llength $args]} {
  1844.     eval lappend res [eval dialog::button $args]
  1845.     return $res
  1846.     }
  1847.     incr y 30
  1848.     return $res
  1849. }
  1850. proc dialog::title {name w} {
  1851.     set l [expr {${w}/2 - 4 * [string length $name]}]
  1852.     if {$l < 0} {set l 0}
  1853.     return [list -t $name $l 10 [expr {$w - $l}] 25]
  1854. }
  1855. ## 
  1856.  # -------------------------------------------------------------------------
  1857.  # 
  1858.  # "dialog::text" --
  1859.  # 
  1860.  #  Creates a text box wrapping etc the text to fit appropriately.
  1861.  #  In the input text 'name', "\r" is used as a paragraph delimiter,
  1862.  #  and "\n" is used to force a linebreak.  Paragraphs have a wider
  1863.  #  spread.
  1864.  # -------------------------------------------------------------------------
  1865.  ##
  1866. proc dialog::text {name x yy {split 0}} {
  1867.     upvar $yy y
  1868.     if {!$split || $name == ""} {
  1869.     set res [list -t $name $x $y [expr {$x + 7 * [string length $name]}] \
  1870.       [expr {$y +15}]]
  1871.     incr y 18
  1872.     } else {
  1873.     global fillColumn
  1874.     set f $fillColumn
  1875.     set fillColumn $split
  1876.     set name [string trim $name]
  1877.     set paragraphList [split $name "\r"]
  1878.     foreach para $paragraphList {
  1879.         set lines ""
  1880.         foreach line [split $para "\n"] {
  1881.         lappend lines [breakIntoLines $line]
  1882.         }
  1883.         set lines [join $lines "\r"]
  1884.         foreach line [split $lines "\r"] {
  1885.         eval lappend res [list -t $line $x $y [expr {$x + 4+ 8 * [string length $line]}] \
  1886.           [expr {$y +15}]]
  1887.         incr y 18
  1888.         }
  1889.         incr y 10
  1890.     }
  1891.     set fillColumn $f
  1892.     }
  1893.     return $res
  1894. }
  1895. proc dialog::edit {name x yy chars {cols 1}} {
  1896.     upvar $yy y
  1897.     set res [list -e $name $x $y [expr {$x + 10 * $chars}] [expr {$y + 15 * $cols}]]
  1898.     incr y [expr {5 + 15*$cols}]
  1899.     return $res
  1900. }
  1901. proc dialog::textedit {name default x yy chars {height 1}} {
  1902.     upvar $yy y
  1903.     set res [list -t $name $x $y [expr {$x + 8 * [string length $name]}]\
  1904.       [expr {$y +16}] \
  1905.       -e $default $x [expr {$y + 20}] [expr {$x + 10 * $chars}] \
  1906.       [expr {$y +20 + 16*$height}]]
  1907.     incr y [expr {24 + 16*$height}]
  1908.     return $res
  1909. }
  1910. proc dialog::checkbox {name default x yy} {
  1911.     upvar $yy y
  1912.     set res [list -c $name $default $x $y]
  1913.     set c [regsub -all -nocase {[wm]} $name "" ""]
  1914.     set len [expr {3+ 10 * [string length $name] + 4 * $c}]
  1915.     lappend res [expr {$x + $len}] [expr {$y +15}]
  1916.     incr y 18
  1917.     return $res
  1918. }
  1919.  
  1920. # ◊◊◊◊ Multiple bindings dialogs ◊◊◊◊ #
  1921.  
  1922. proc dialog::arrayBindings {name array {for_menu 0}} {
  1923.     upvar $array a
  1924.     foreach n [array names a] {
  1925.     lappend l [list $a($n) $n]
  1926.     }
  1927.     if {[info exists l]} {
  1928.     eval dialog::adjustBindings [list $name modified "" $for_menu] $l
  1929.     }
  1930.     array set a [array get modified]
  1931. }
  1932.  
  1933. ## 
  1934.  # -------------------------------------------------------------------------
  1935.  # 
  1936.  # "dialog::adjustBindings" --
  1937.  # 
  1938.  #  'args' is a list of pairs.  The first element of each pair is the 
  1939.  #  menu binding, and the second element is a descriptive name for the
  1940.  #  element. 'array' is the name of an array in the calling proc's
  1941.  #  scope which is used to return modified bindings.
  1942.  # 
  1943.  # Results:
  1944.  #  
  1945.  # --Version--Author------------------Changes-------------------------------
  1946.  #    1.0     Johan Linde               original for html mode
  1947.  #    1.1     <darley@fas.harvard.edu> general purpose version
  1948.  #    1.2     Johan Linde              split into two pages when many items
  1949.  # -------------------------------------------------------------------------
  1950.  ##
  1951. proc dialog::adjustBindings {name array {mod {}} {for_menu 1} args} {
  1952.     global screenHeight
  1953.     regsub -all {\"\(-\"} $args "" items
  1954.     upvar $array key_changes
  1955.     
  1956.     foreach it $items {
  1957.     if {[info exists key_changes([lindex $it 1])]} {
  1958.         set tmpKeys([lindex $it 1]) $key_changes([lindex $it 1])
  1959.     } else {
  1960.         set tmpKeys([lindex $it 1]) [lindex $it 0]
  1961.     }
  1962.     }
  1963.     # do we return modified stuff?
  1964.     if {$mod != ""} { upvar $mod modified }
  1965.     set modified ""
  1966.     set page "Page 1 of $name"
  1967.     while {1} {
  1968.     # Build dialog.
  1969.     set twoWindows 0
  1970.     set box ""
  1971.     set h 30
  1972.     foreach it $items {
  1973.         if {$it == "(-"} {continue}
  1974.         set w 210
  1975.         set w2 370
  1976.         set key $tmpKeys([lindex $it 1])
  1977.         set key1 [dialog::specialView_binding $key]
  1978.         set it2 [split [lindex $it 1] /]
  1979.         if {[llength $it2] == 1} {
  1980.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  1981.         eval lappend box [dialog::buttonSet 10 $h]
  1982.         incr h 17
  1983.         } else {
  1984.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  1985.         eval lappend box [dialog::buttonSet 10 [expr {$h +8}]]
  1986.         incr h 17
  1987.         if {$key1 != "<no binding>"} {regsub {((ctrl-)?(shift-)?)(.*)} $key1 {\1opt-\4} key1}
  1988.         lappend box -t [lindex $it2 1] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  1989.         incr h 17
  1990.         }
  1991.         if {$it != [lindex $items [expr {[llength $items] -1}]] && !$twoWindows && [set twoWindows [expr {$h + 100 > $screenHeight}]]} {
  1992.         set box " -n [list [concat Page 1 of $name]] $box -n [list [concat Page 2 of $name]] "
  1993.         set hmax $h; set h 30
  1994.         }
  1995.     }
  1996.     if {[info exists hmax]} {set h $hmax}
  1997.     if {$twoWindows} {
  1998.         set top "-m [list [list $page [concat Page 1 of $name] [concat Page 2 of $name]]] 10 10 370 25"
  1999.     } else {
  2000.         set top "-t [list $name] 50 10 250 25"
  2001.     }
  2002.     set buttons "-b OK 20 [expr {$h + 10}] 85 [expr {$h + 30}]  -b Cancel 105 [expr {$h + 10}] 170 [expr {$h + 30}]"
  2003.     set values [eval [concat dialog -w 380 -h [expr {$h + 40}]  $buttons $top $box]]
  2004.     if {$twoWindows} {set page [lindex $values 2]}
  2005.     if {[lindex $values 1]} {
  2006.         # Cancel
  2007.         return "Cancel"
  2008.     } elseif {[lindex $values 0]} {
  2009.         # Save new key bindings
  2010.         foreach it $modified {
  2011.         set key_changes($it) $tmpKeys($it)
  2012.         }
  2013.         return
  2014.     } else {
  2015.         # Get a new key.
  2016.         set it [lindex [lindex $items [expr {[lsearch $values 1] - 2 - $twoWindows}]] 1]
  2017.         if {![catch {dialog::getAKey $it $tmpKeys($it) $for_menu} newKey]  && $newKey != $tmpKeys($it)} {
  2018.         set tmpKeys($it) $newKey
  2019.         lappend modified $it
  2020.         }
  2021.     }
  2022.     }
  2023. }
  2024.  
  2025. # ◊◊◊◊ Manipulation of special pref types ◊◊◊◊ #
  2026.  
  2027. proc dialog::specialView_binding {key} {
  2028.     append key1 [keys::modifiersTo $key "verbose"]
  2029.     append key1 [keys::verboseKey $key]
  2030.     if {$key1 == ""} { return "<no binding>" }
  2031.     return $key1
  2032. }
  2033.  
  2034. proc dialog::specialSet_binding {v {menu 0}} {
  2035.     # Set… pressed
  2036.     set oldB [dialog::getFlag $v]
  2037.     if {![catch {dialog::getAKey [quote::Prettify $v] $oldB $menu} newKey] && $newKey != $oldB} {
  2038.     dialog::modified $v $newKey
  2039.     }
  2040. }
  2041.  
  2042. proc dialog::specialView_menubinding {key} {
  2043.     dialog::specialView_binding $key
  2044. }
  2045.  
  2046. proc dialog::specialSet_menubinding {v} {
  2047.     dialog::specialSet_binding $v 1
  2048. }
  2049. proc dialog::specialView_Sig {vv} {
  2050.     if {$vv != ""} {
  2051.     if {[catch {nameFromAppl $vv} path]} {
  2052.         return "Unknown application with sig '$vv'"
  2053.     } else {
  2054.         return [dialog::specialView_file $path]
  2055.     }
  2056.     }
  2057.     return ""
  2058. }
  2059.  
  2060. proc dialog::specialView_io-file {vv} {
  2061.     dialog::specialView_file $vv
  2062. }
  2063.  
  2064. proc dialog::specialView_file {vv} {
  2065.     if {[set sl [string length $vv]] > 40} {
  2066.     set vv "[string range $vv 0 14]...[string range $vv [expr {$sl -22}] end]"
  2067.     }
  2068.     return $vv
  2069. }
  2070. proc dialog::specialSet_file {v} {
  2071.     # Set… pressed
  2072.     set old [dialog::getFlag $v]
  2073.     if {![catch {getfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2074.       && $ff != $old} {
  2075.     dialog::modified $v $ff
  2076.     }
  2077. }
  2078. proc dialog::specialSet_io-file {v} {
  2079.     # Set… pressed
  2080.     set old [dialog::getFlag $v]
  2081.     if {![catch {putfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2082.       && $ff != $old} {
  2083.     dialog::modified $v $ff
  2084.     }
  2085. }
  2086.  
  2087.  
  2088.  
  2089.  
  2090.  
  2091.